The X-Philes (2nd Revision)

home *** CD-ROM | disk | FTP | other *** search

/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / suite3d4.src < prev next >

Wrap

Text File | 1993-02-18 | 14KB | 641 lines

%%HP: T(3)A(R)F(.); DIR VPAR DIR Xleft 0 Xright 3 Ynear 0 Yfar 3 Zlow -1 Zhigh 2.5 XXleft 0 XXright 3 YYlow 0 YYhigh 3 Xe 2.5 Ye -1.5 Ze 2 Nx 13 Ny 8 Hidden 0 END SlopeField \<< {VPAR Nx} RCL {VPAR Ny} RCL {VPAR Xleft} RCL {VPAR Xright} RCL DUP2 XRNG {VPAR Ynear} RCL {VPAR Yfar} RCL DUP2 YRNG EQ 0 0 0 0 0 0 0 \-> numx numy left right bot top der hstp vstp hofs vofs x y d \<< ERASE {# 0d # 0d } PVIEW right left - numx / 'hstp' STO top bot - numy / 'vstp' STO hstp .4 * 'hofs' STO vstp .4 * 'vofs' STO bot vstp 2 / + top FOR y y 'Y' STO left hstp 2 / + right FOR x x 'X' STO der \->NUM 'd' STO 'IFTE(ABS(d*hofs)>vofs,vofs/d+i*vofs,hofs+i*hofs*d)' \->NUM x y R\->C DUP2 + 3 ROLLD SWAP - line hstp STEP vstp STEP \>> { X Y } PURGE { } PVIEW \>> psContour \<< EQ \<< \-> dx dy 'IFTE(dy==0,MAXR,-dx/dy)' \>> \-> eq slp \<< IFERR eq X \.d eq Y \.d 2 \->LIST 'slp' APPLY { X Y } SHOW STEQ SlopeField THEN eq STEQ ERRM DOERR END eq STEQ \>> \>> YView \<< SetWindow 0 \<< \-> K \<< CASE K TYPE DUP 0 == THEN DROP X K R\->C X -50 R\->C DUP2 LINE TLINE K END 1 == THEN K END K EVAL 1 \->LIST 'PRASE' APPLY END \>> \>> \-> Xleft Xright Ynear Yfar Xe Ye Ze Nx Ny prase u hline \<< 'EQ' RCL 'u' \-> eq u \<< eq { X '(X-Xe)*u+Xe' Y 'u+Ye' } | Ze - 'u' / Ze + { X u } SHOW COLCT IF prase THEN { & 'hline(&)' } \|vMATCH DROP END IFERR 'EQ' STO 'X' INDEP ERASE Ynear Yfar - 8 / \-> stp \<< Yfar Ye - Ynear Ye - FOR u draw IF KEY THEN DROP "outa here" DOERR END stp STEP \>> THEN eq STEQ ERRM DOERR ELSE eq STEQ END { } PVIEW \>> \>> \>> WIREFRAME \<< SetWindow 0 0 0 0 \-> Xmin Xmax Ynear Yfar Xe Ye Ze numx numy prase u v bd1 bd2 \<< 'u' 'v' \-> u v \<< EQ { X v Y 'u+Ye' } | Ze - 'u' / Ze + { v u } SHOW COLCT ERASE { # 0d # 0d } PVIEW Ynear Yfar - numy / Xmax Xmin - numx / \-> eq stpu stpx \<< Yfar Ye - Ynear Ye - FOR u 0 'bd1' STO Xmin 'v' STO 0 numx START v Xe - u / Xe + eq \->NUM R\->C IF bd1 THEN DUP2 line ELSE 1 'bd1' STO END IF bd2 THEN numx 2 + ROLL OVER line END stpx 'v' STO+ NEXT 1 'bd2' STO stpu STEP numx 1 + DROPN \>> { } PVIEW \>> \>> \>> ShapeToShade \<< {VPAR Xleft} RCL {VPAR Xright} RCL {VPAR Ynear} RCL {VPAR Yfar} RCL 0 0 0 \-> xmin xmax ymin ymax x y eq \<< xmax xmin - 32 / ymin ymax - 15.001 / 'x' 'y' \-> xstp ystp x y \<< EQ DUP X \.d .4 - 2 ^ SWAP Y \.d .4 + 2 ^ + 1 + -.35 ^ { X x Y y } | COLCT 'eq' STO ERASE {# 0d # 0d } PVIEW # 0d ymax ymin FOR y # 0d xmin xmax FOR x DUP2 SWAP 2 \->LIST PICT SWAP eq \->NUM IF DUP TYPE 0 \=/ THEN DROP 1 END tile 15.99 * IP DPAR SWAP 16 - NEG GET REPL 4 + xstp STEP DROP 4 + ystp STEP DROP { } PVIEW \>> \>> \>> Movie \<< {VPAR Xleft} RCL {VPAR Xright} RCL XRNG {VPAR Zlow} RCL {VPAR Zhigh} RCL YRNG {VPAR Ynear} RCL {VPAR Yfar} RCL {VPAR Ny} RCL EQ 0 0 \-> ynear yfar numy eq ystp y \<< 'y' 'y' STO eq { X Y } SHOW { Y y } | ynear yfar - numy / 'ystp' STO IFERR STEQ 'X' INDEP FUNCTION 0 yfar ynear FOR y ERASE draw y PICT RCL ROT 2 + IF KEY THEN DROP "outa here" DOERR END ystp STEP THEN eq STEQ ERRM DOERR END eq STEQ \>> uSMOV \>> uSMOV \<< \-> n \<< { # 0d # 0d } PVIEW DO n ROLL n ROLL DUP PICT {# 0d # 0d } ROT REPL UNTIL KEY END DROP n \>> \>> SSTMovie \<< DO \-> n \<< n ROLL n ROLL DUP PICT {# 0d # 0d } ROT REPL n { # 0d # 0d } PVIEW \>> UNTIL 0 WAIT 51.1 == END \>> PARSURFACE \<< SetWindow 3 DROPN EQ \-> xe ye ze eq \<< 4 DROPN eq LIST\-> DROP SWAP ye - SWAP ze - OVER / ze + 'i' * ROT xe - ROT / xe + + IFERR STEQ 0 dogridmap THEN eq STEQ ERRM DOERR ELSE eq STEQ END \>> \>> GRIDMAP \<< 1 dogridmap \>> dogridmap \<< EQ PPAR VPAR XXright XXleft YYlow YYhigh Xleft Xright Ynear Yfar Nx Ny UPDIR \-> setrng eq pp X1 X2 Y1 Y2 xr1 xr2 yr1 yr2 NX NY \<< X2 X1 - Y2 Y1 - \-> DX DY \<< eq { X 'X1+DX*(1+INV(NX-1))* (.5+(-1)^IP(NY*((1-INV(NX*NY))*TTT+.5/(NX*NY)))* (-.5+FP(NY*((1-INV(NX*NY))*TTT+.5/(NX*NY)))))- .5*(DX/(NX-1))' Y 'Y1+DY/(NY-1)*IP(NY*((1-INV(NX*NY))*TTT+.5/(NX*NY)))' } | { TTT } SHOW eq { X 'X1+DX/(NX-1)*IP(NX*((1-INV(NY*NX))*TTT+.5/(NY*NX)))' Y 'Y1+DY*(1+INV(NY-1))* (.5+(-1)^IP(NX*((1-INV(NY*NX))*TTT+.5/(NY*NX)))* (-.5+FP(NX*((1-INV(NY*NX))*TTT+.5/(NY*NX)))))- .5*(DY/(NY-1))' } | { TTT } SHOW SWAP IFERR { TTT 0 1 } INDEP PARAMETRIC IF setrng THEN xr1 xr2 XRNG yr1 yr2 YRNG END NX NY * 1 - INV RES STEQ ERASE pardraw STEQ pardraw { } PVIEW pp 'PPAR' STO eq STEQ THEN eq STEQ pp 'PPAR' STO ERRM DOERR END \>> \>> \>> DPAR { GROB 4 4 00400000 GROB 4 4 00402000 GROB 4 4 90000080 GROB 4 4 40104010 GROB 4 4 20802090 GROB 4 4 8050A010 GROB 4 4 50A05080 GROB 4 4 A050A050 GROB 4 4 50A050A0 GROB 4 4 A050A070 GROB 4 4 70A050E0 GROB 4 4 D070D060 GROB 4 4 B0E0B0E0 GROB 4 4 70D0F0B0 GROB 4 4 F0B0D0F0 GROB 4 4 F0B0F0F0 } EQ '2*(2-Y)*EXP(-((X-.5)^2+(Y-1.2)^2))+Y*EXP(-2*((X-2)^2+(Y-2)^2))' PPAR { (-2,0) (2,5) X # 8d (0,0) FUNCTION Y } SetWindow \<< PATH VPAR Xleft Xright Ynear Yfar Zlow Zhigh Xe Ye Ze Nx Ny Hidden 0 \-> Xleft Xright Ynear Yfar Zlow Zhigh Xe Ye Ze Nx Ny Hidden Ue \<< EVAL \<< \-> u y '(u-Ue)/(y-Ye)+Ue' SWAP OVER MAX ROT ROT MIN SWAP \>> \-> proj \<< Xe 'Ue' STO MAXR \->NUM DUP NEG Xleft Ynear proj EVAL Xleft Yfar proj EVAL Xright Ynear proj EVAL Xright Yfar proj EVAL XRNG Ze 'Ue' STO MAXR \->NUM DUP NEG Zlow Ynear proj EVAL Zlow Yfar proj EVAL Zhigh Ynear proj EVAL Zhigh Yfar proj EVAL YRNG \>> Xleft Xright Ynear Yfar Xe Ye Ze Nx Ny Hidden \>> \>> draw DRAW line LINE tile \<< \>> pardraw DRAW @ Begin POSTSCRIPT Stuff @ PSTOGGLE \<< "PS is " IF 'draw' RCL 'PSDRAW' SAME THEN { DRAW } 1 GET DUP 'draw' STO 'pardraw' STO { LINE } 1 GET 'line' STO \<< \>> 'tile' STO "Off" + ELSE 'PSDRAW' 'draw' STO 'PSLINE' 'line' STO 'PSTILE' 'tile' STO 'PSPARDRAW' 'pardraw' STO "On" + END 1 DISP \>> PSRESET \<< "'PSOUT" 'PSOUT' DO "" SWAP STO "&" + DUP STR\-> DUP UNTIL VTYPE -1 == END DROP2 'PSOUT' 'CURRENTOUT' STO \>> PSTILE \<< DUP \->STR " g " + 5 PICK B\->R DUP 4 + \->STR " " + SWAP \->STR " " + 8 PICK # 64d SWAP - B\->R DUP 4 - \->STR " " + SWAP \->STR " " + \-> X2 X1 Y1 Y2 \<< X2 + Y1 + "m " + X2 + Y2 + "L " + X1 + Y2 + "L " + X1 + Y1 + "L " + X2 + Y1 + "L f " + \>> PSADDTO \>> PSADDTO \<< IF CURRENTOUT SIZE 4000 > THEN 'CURRENTOUT' RCL \->STR 1 OVER SIZE 1 - SUB "&" + STR\-> DUP 'CURRENTOUT' STO STO ELSE 'CURRENTOUT' RCL SWAP STO+ END \>> CURRENTOUT PSOUT PSCOPAIR \<< 'PPAR(1)' EVAL DUP 'PPAR(2)' EVAL SWAP - \-> p1 p2 o d \<< p2 o - C\->R d C\->R ROT SWAP / 64 * ROT ROT / 131 * p1 o - C\->R d C\->R ROT SWAP / 64 * ROT ROT / 131 * \>> \-> y2 x2 y1 x1 \<< x1 \->STR " " + y1 \->STR " " + + x2 \->STR " " + + y2 \->STR " " + + x2 x1 - x2 + \->STR " " + y2 y1 - y2 + \->STR " " + + \>> \>> PSDRAW \<< PPAR OBJ\-> 4 DROPN 0 0 \-> hm vm indp rs flop \Gdx \<< IF rs TYPE 10 == THEN rs # 0d 2 \->LIST PX\->C hm - RE ELSE IF rs 0 == THEN { # 1d # 0d } PX\->C hm - RE ELSE rs END END 3 / '\Gdx' STO 'EQ' RCL 'vm' STO \<< \-> vl \<< vl \->NUM indp \->NUM \-> vlu indv \<< IF flop THEN indv \Gdx - vl indp \.d \->NUM \Gdx * vlu SWAP - R\->C 'indp+vl*i' \->NUM PSCOPAIR 3 ROLLD + "c " + PSADDTO ELSE 'indp+vl*i' \->NUM PSCO "m " + indv \Gdx + vl indp \.d \->NUM \Gdx * vlu + R\->C PSCO + 1 'flop' STO END vlu \>> \>> \>> 'hm' STO IFERR vm {& 'hm(QUOTE(&))' } \|vMATCH DROP STEQ DRAW vm STEQ THEN vm STEQ ERRM DOERR END "S " PSADDTO \>> \>> PSPARDRAW \<< 'PPAR(3)' EVAL OBJ\-> DROP 'PPAR(4)' EVAL 0 0 \-> indp hm vm rs flop \Gdx \<< IF rs 0 == THEN # 1d 'rs' STO END IF rs TYPE 10 == THEN rs B\->R 131 / vm hm - * ELSE rs END 3 / '\Gdx' STO 'EQ' RCL 'vm' STO \<< \-> vl \<< vl \->NUM indp \->NUM \-> vlu indv \<< IF flop THEN vl indp \.d \->NUM \Gdx * vlu SWAP - (0,0) + vlu (0,0) + PSCOPAIR 3 ROLLD + "c " + PSADDTO ELSE vlu (0,0) + PSCO "m " + vl indp \.d \->NUM \Gdx * vlu + (0,0) + PSCO + 1 'flop' STO END vlu \>> \>> \>> 'hm' STO IFERR vm { & 'hm(QUOTE(&))' } \|vMATCH DROP STEQ DRAW vm STEQ THEN vm STEQ ERRM DOERR END "S " PSADDTO \>> \>> PSCO \<< 'PPAR(1)' EVAL - C\->R 'PPAR(2)-PPAR(1)' EVAL C\->R ROT SWAP / 64 * ROT ROT / 131 * \->STR " " + SWAP \->STR " " + + \>> PSLINE \<< \-> C1 C2 \<< C1 PSCO "m " + C2 PSCO + "l S " + PSADDTO C1 C2 LINE \>> \>> derFP \<< \-> K DK 'DK' \>> derIP \<< \-> K DK '0' \>> derIM \<< \-> K DK 'IM(DK)' \>> derRE \<< \-> K DK 'RE(DK)' \>> PSOUT "" PSOUT& "" PSOUT&& "" PSOUT&&& "" PSOUT&&&& "" PSOUT&&&&& "" PSOUT&&&&&& "" END